home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / rbbsdir4.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-25  |  5.6 KB  |  157 lines
  1. 1  ' DIRUTIL.BAS  Directory utility for RBBS-PC
  2. 2  ' Lists, Adds, and searches for files in RBBS-PC directories.
  3. 3  '
  4. 4  ' 08/13/84   Will Carlton
  5. 5  '
  6. 6  ' 11/10/84  ADDED DIRECTORY SORT WITH DELETE OPTION (TS)
  7. 7  '
  8. 10  ON ERROR GOTO 910
  9. 20  DIM DIR$(128),SW%(20,2),NAM$(999)
  10. 30  KEY OFF:CLS
  11. 40  LOCATE 1,23:PRINT "RBBS-PC DIRECTORY MAINTENANCE UTILITY":PRINT
  12. 50  PRINT "What drive do the directory files reside on (A,B,C, or D) ? "
  13. 60  GOSUB 760:DRV$=I$
  14. 70  DRV$=MID$(DRV$,1,1):IF INSTR("ABCDabcd",DRV$)=0 THEN 60
  15. 80  'FIL=0:CLS:FILES DRV$+":dir*.":FOR Y=2 TO 24:FOR X=1 TO 80 STEP 18:FIL$="":FOR Z=(X*18)+1 TO 18:F$=CHR$(SCREEN(Y,Z)):FIL$=FIL$+F$:NEXT Z:FIL=FIL+1:DIR$(FIL)=FIL$:NEXT X:NEXT Y
  16. 90  '
  17. 100  ' Menu
  18. 105  '
  19. 110  CLS:LOCATE 1,23:PRINT "RBBS-PC DIRECTORY MAINTENANCE UTILITY"
  20. 115  LOCATE 4,5:PRINT "1 - LIST DIRECTORY"
  21. 123  LOCATE 4,50:PRINT "5 - SORT W/ DELETE OPTION"
  22. 125  LOCATE 5,5:PRINT "2 - UPDATE DIRECTORY"
  23. 127  LOCATE 5,50:PRINT "6 - QUIT"
  24. 130  LOCATE 6,5:PRINT "3 - SEARCH FOR STRING IN A DIRECTORY"
  25. 135  LOCATE 7,5:PRINT "4 - CHANGE DRIVE"
  26. 140  GOSUB 710
  27. 145  LOCATE 9,25:PRINT "Enter your selection: "
  28. 150  GOSUB 760:SEL$=I$
  29. 155  ON VAL(SEL$) GOTO 610,200,410,30,1000,810
  30. 160  GOTO 150
  31. 165  '
  32. 200  'Update Directory
  33. 205  LOCATE 11,1:INPUT "WHAT DIRECTORY TO CREATE/UPDATE (PRESS <ENTER> TO QUIT) ";DIRECT$
  34. 210  IF DIRECT$="" THEN 110
  35. 215  OPEN DRV$+":"+DIRECT$ FOR APPEND AS #1
  36. 220  GOSUB 990
  37. 225  LOCATE 12,1:INPUT "PROGRAM NAME (INCLUDE EXTENSION) ";PROGNAME$
  38. 230  IF LEN(PROGNAME$)>12 OR INSTR(PROGNAME$," ") THEN PRINT CHR$(7);:GOTO 225
  39. 235  IF INSTR(PROGNAME$,".")=0 THEN PROGNAME$=PROGNAME$+"."
  40. 240  UPARS$=PROGNAME$:GOSUB 510:PROGNAME$=PARS$+"   ":PROG$=MID$(PROGNAME$,1,INSTR(PROGNAME$,".")-1):EXTEN$=MID$(PROGNAME$,INSTR(PROGNAME$,".")+1,3)
  41. 245  IF LEN(EXTEN$)>3 OR LEN(PROG$)>8 THEN PRINT CHR$(7):GOTO 225
  42. 250  INPUT "PROGRAM SIZE ";SIZE$
  43. 255  IF LEN(SIZE$)>9 THEN PRINT CHR$(7):GOTO 250
  44. 260  SIZE=VAL(SIZE$)
  45. 265  INPUT "ENTER DATE IN THE FORM (MM/DD/YY) (C/R FOR TODAY) ";CREATE$
  46. 270  IF CREATE$="" THEN CREATE$=MID$(DATE$,1,6)+MID$(DATE$,9,2)
  47. 275  IF LEN(CREATE$)<>8 THEN PRINT CHR$(7):GOTO 265
  48. 280  PRINT "ENTER 40 (32) CHARACTER DESCRIPTION OF ";PROGNAME$
  49. 285  LOCATE 16,1:PRINT "  1---+---1+0---+---2+0---+---3+0--*+---4+0"
  50. 290  INPUT DESCRIP$
  51. 295  IF LEN(DESCRIP$)>40 THEN PRINT CHR$(7):GOTO 285
  52. 300  PRINT#1,USING"\      \ \ \ ######### \      \  ";PROG$;EXTEN$;SIZE;CREATE$;:PRINT#1,DESCRIP$
  53. 305  PRINT "MORE (Y/N) "
  54. 310  MORE$=INKEY$
  55. 315  IF MORE$="Y" OR MORE$="y" THEN 220 ELSE IF MORE$="N" OR MORE$="n" THEN CLOSE:GOTO 110
  56. 320  GOTO 310
  57. 400  '
  58. 410  'Search routine
  59. 415  IF NOT OKFIL THEN LOCATE 11,1:COLOR 15:PRINT "No directories found!  Change diskette or drive specification.  ";:COLOR 7:BEEP:PRINT "Press any key.":GOSUB 990:GOSUB 750:GOTO 100
  60. 420  GOSUB 990
  61. 430  LOCATE 11,1:INPUT "Enter the directory to search in ";DIRECT$:IF DIRECT$="" THEN 110
  62. 440  LOCATE 12,1:INPUT "Enter the string to search for ";SRCH$:IF SRCH$="" THEN 110 ELSE UPARS$=SRCH$:GOSUB 510:SRCH$=PARS$
  63. 450  CLOSE #1:OPEN DRV$+":"+DIRECT$ FOR INPUT AS #1
  64. 460  CLS:LINE INPUT #1,L$:PRINT L$:PRINT:PRINT "Control <K> to quit listing":PRINT
  65. 470  IF EOF(1) THEN 675 ELSE LINE INPUT #1,L$:UPARS$=L$:GOSUB 510:IF INSTR(PARS$,SRCH$)<> 0 THEN PRINT L$
  66. 480  STP$=INKEY$:IF STP$="" THEN 470 ELSE IF STP$=CHR$(11) THEN PRINT:PRINT "Listing aborted.":GOTO 675
  67. 490  STRT$=INKEY$:IF STRT$="" THEN 490 ELSE GOTO 470
  68. 500  '
  69. 510  'Parsing routine
  70. 520  PARS$="":FOR I=1 TO LEN(UPARS$):P$=MID$(UPARS$,I,1)
  71. 530  IF ASC(P$)>96 THEN P$=CHR$(ASC(P$)-32)
  72. 540  PARS$=PARS$+P$:NEXT:RETURN
  73. 550  '
  74. 600  'List directory
  75. 610  LOCATE 12,1:INPUT "WHAT DIRECTORY TO LIST (PRESS <ENTER> TO QUIT) ";DIRECT$
  76. 620  IF DIRECT$="" THEN 110
  77. 630  CLOSE #1:OPEN DRV$+":"+DIRECT$ FOR INPUT AS #1
  78. 640  CLS:ON EOF(1) GOTO 675:LINE INPUT #1,L$:PRINT L$:PRINT:PRINT "Control <K> to quit listing.":PRINT
  79. 650  WHILE NOT EOF(1)
  80. 655    LINE INPUT #1,L$:PRINT L$
  81. 660    STP$=INKEY$:IF STP$="" THEN 650 ELSE IF STP$=CHR$(11) THEN PRINT "Listing aborted.":GOTO 675
  82. 665    STRT$=INKEY$:IF STRT$="" THEN 665 ELSE GOTO 650
  83. 670  WEND
  84. 675  CLOSE #1:PRINT:PRINT "End of File.  Press any key....":GOSUB 760:GOTO 110
  85. 685  '
  86. 695  END
  87. 700  'Show DIR files
  88. 710  OKFIL=-1:LOCATE 13,1:FILES DRV$+":dir*.":LOCATE 9,1:RETURN
  89. 750  ' Get a key routine
  90. 760  I$=INKEY$:IF I$="" THEN 760 ELSE RETURN
  91. 800  ' End of program
  92. 810  SOUND 250,3:CLOSE:CLS:SOUND 500,7:LOCATE 12,20:COLOR 13:SOUND 400,5:PRINT "H A V E   A   N I C E   D A Y !":FOR I=1 TO 999:NEXT:END
  93. 900  ' ERROR HANDLING
  94. 910  IF ERR=53 AND ERL=215 THEN COLOR 15:BEEP:LOCATE 12,50:PRINT "File not found. Will create it":LOCATE 13,1:OPEN DIRECT$ FOR OUTPUT AS #1:RESUME 225
  95. 920  IF ERR=53 AND ERL=630 THEN COLOR 15:BEEP:LOCATE 12,62:PRINT "File not found!":BEEP:COLOR 7:RESUME 610
  96. 925  IF ERR=53 AND ERL=450 THEN COLOR 15:BEEP:LOCATE 12,62:PRINT "File not found!":BEEP:COLOR 7:RESUME 675
  97. 930  IF ERR=53 AND ERL=710 THEN OKFIL=0:PRINT "No files found!":BEEP:COLOR 7:RESUME NEXT
  98. 940  IF ERR=53 AND ERL=80 THEN OKFIL=0:PRINT "No files found!":BEEP:COLOR 7:RESUME 110
  99. 945  IF ERR=53 AND ERL=1383 THEN RESUME 1390
  100. 950  LOCATE 25,1:COLOR 15:PRINT "Error ";ERR;" occurred in line ";ERL:COLOR 7:BEEP
  101. 960  END
  102. 970  FOR I=1 TO 128:PRINT DIR$(I);:NEXT
  103. 990  FOR I=12 TO 23:LOCATE I,1:PRINT SPACE$(79):NEXT:RETURN
  104. 1000  LOCATE 11,1:INPUT"Sort which directory (CR to QUIT)  ";DIRECT$
  105. 1010  IF DIRECT$="" THEN 110
  106. 1020  CLOSE #1:OPEN DRV$+":"+DIRECT$ FOR INPUT AS #1
  107. 1030  OPEN DRV$+":TMP" FOR APPEND AS #2
  108. 1040  CNT%=0:LINE INPUT #1,L$:PRINT #2,L$
  109. 1041  LOCATE 12,1:PRINT"Do you wish to mark entries for DELETION  ";
  110. 1043  GOSUB 760:A$=LEFT$(I$,1):IF (A$="Y") OR (A$="y") THEN 1500
  111. 1050  WHILE NOT EOF(1)
  112. 1060  LINE INPUT #1,L$:CNT%=CNT%+1
  113. 1070  NAM$(CNT%)=LEFT$(L$,8)
  114. 1080  WEND
  115. 1090  P%=1:SW%(P%,1)=1:SW%(P%,2)=CNT%
  116. 1095  LOCATE 22,1:PRINT"Sorting ..";
  117. 1100  IF P%<0 THEN 1320
  118. 1110  I1%=SW%(P%,1):J1%=SW%(P%,2)
  119. 1120  P%=P%-1
  120. 1130  GOSUB 1140:GOTO 1100
  121. 1140  PRINT".";
  122. 1150  IF J1%<=I1% THEN 1310
  123. 1160  I%=I1%:J%=J1%
  124. 1170  SAMP%=-1
  125. 1180  IF I%>=J% THEN 1280
  126. 1190  IF NAM$(I%)<=NAM$(J%) THEN 1240
  127. 1210  SWAP NAM$(I%),NAM$(J%)
  128. 1230  SAMP%=-SAMP%
  129. 1240  IF SAMP%<0 THEN 1260
  130. 1250  J%=J%-1:GOTO 1270
  131. 1260  I%=I%+1
  132. 1270  GOTO 1180
  133. 1280  IF (I%+1)>=J1% THEN 1300
  134. 1290  P%=P%+1:SW%(P%,1)=I%+1:SW%(P%,2)=J1%
  135. 1300  J1%=I%-1:GOTO 1150
  136. 1310  RETURN
  137. 1320  '  *END OF SORT*
  138. 1325  CLOSE #1:LOCATE 24,1:PRINT"Writing ..";
  139. 1330  FOR I%=1 TO CNT%
  140. 1335  OPEN DRV$+":"+DIRECT$ FOR INPUT AS #1
  141. 1340  WHILE NOT EOF(1)
  142. 1350  LINE INPUT #1,L$
  143. 1360  IF LEFT$(L$,8)=NAM$(I%) THEN PRINT #2,L$:GOTO 1380
  144. 1370  WEND:PRINT CHR$(7):PRINT"***error***":CLOSE:END
  145. 1380  CLOSE #1:NEXT I%:CLOSE
  146. 1383  KILL DRV$+":"+DIRECT$+".BAK"
  147. 1390  NAME DRV$+":"+DIRECT$ AS DRV$+":"+DIRECT$+".BAK"
  148. 1400  NAME DRV$+":TMP" AS DRV$+":"+DIRECT$
  149. 1410  CLOSE:GOTO 110
  150. 1500  '  *DELETE ENTRIES ROUTINE*
  151. 1505  CLS:LOCATE 1,29:PRINT"DELETE ENTRIES OPTION":LOCATE 3,37:PRINT DIRECT$
  152. 1507  LOCATE 16,1:PRINT"DELETE  (Y=yes, CR=no)  "
  153. 1510  WHILE NOT EOF(1)
  154. 1520  LINE INPUT #1,L$:LOCATE 12,1:PRINT SPACE$(76)
  155. 1530  LOCATE 12,1:PRINT L$:LOCATE 16,26
  156. 1540  GOSUB 760:IF (I$="Y") OR (  GRAF    .DOC  NEWKEY2 .LBR  NHELP   .DQC  IRR     .WKS<UNK! {000D}><UNK! {000A}>FILECOMP.BAS  SKETCH  .BAS  ARTILERY.BAS  MINEFELD.BAS  SPEEDKEY.DOC  
  157.